functor Cfgize (S : CFGIZE_STRUCTS) : CFGIZE =
struct
  open S
  
  structure I = Ir
  structure Cfg = Cfg
  structure T = I.Types
  
  val error = ErrorMsg.error
  
  val tag = false
  fun debugPrint s =
      if tag
      then print s
      else ()
      
  
      
  val doAdjust = true
  
  val toSsa = !Control.doToSsa
  
  local open I
  in
     structure IB = Binop
     structure IL = Le
     structure IS = Structs
     structure IM = Stm
     structure IF = Function
     structure IP = Program
  end
  
  local open Cfg
  in structure Id = Id
     structure Intl = Intl
     structure B = Binop
     structure O = Operand
     structure K = Block
     structure S = Structs
     structure J = Transfer
     structure M = Stm
     structure F = Function
     structure P = Program
  end
  
  fun printList (n, l, info) =
      let val _ = debugPrint (String.concat ["\nthe ", info, " of ", Id.toString n, " is:\n"])
          val _ = List.app debugPrint (List.map Id.toString l)
      in  ()
      end
      
  structure VarPool :>
  sig
    val add : {id : Id.t, ty : T.t} -> unit
    val getAll : unit -> {id : Id.t, ty : T.t} list
  end =
  struct
    val all : {id : Id.t, ty : T.t} list ref = ref []
      
    fun add {id, ty} = all := {id = id, ty = ty} :: (!all)
    fun init () = all := []
    fun getAll () =
        let val x = !all
            val _ = init ()
        in  x
        end
  end
  
  structure StmPool :>
  sig      
    val emit : M.t -> unit
    val emits : M.t list -> unit
    val init : unit -> unit
    val get : unit -> M.t list
  end =
  struct
    val all : M.t list ref = ref []
    
    val init = fn () => all := []    
    fun emit s = all := (!all) @ [s]
    fun emits ss = List.app emit ss
    fun get () = !all
  end
  
  structure BlockPool :
  sig
    val add : M.t -> unit
    val flush : Id.t list -> unit
    val getAll : unit -> K.t list
    val initAll : unit -> unit
  end =
  struct
    val all : K.t list ref = ref []
    val one : M.t list ref = ref []
        
    fun add s = one := (!one) @ [s]
        
    fun flush (succs) =
        let val b = K.T {name = Id.new (),
                         prop = true,
                         stms = !one,
                         transfer = J.bogus (),
                         successors = succs}
        in  all := (!all) @ [b]
        ; one := []
        end
    
    fun initAll () = (all := []; one := [])       
    fun getAll () = !all before initAll ()
  end
  
  fun transBop bop = 
      let val _ = ()
      in  case bop
           of IB.Plus => B.Plus
	    | IB.Minus => B.Minus
	    | IB.Times => B.Times
	    | IB.Divide => B.Divide
	    | IB.Modus => B.Modus
	    | IB.And => B.And
	    | IB.Or => B.Or
	    | IB.Eq => B.Eq
	    | IB.Ne => B.Ne
	    | IB.Gt => B.Gt
	    | IB.Ge => B.Ge
	    | IB.Lt => B.Lt
	    | IB.Le => B.Le
      end
  
  fun ckLval (lval) : {value : O.t} =
      case lval
       of IL.Var {id, ty, pos} =>
			   {value = O.Var {id = id, ty = ty}}
	| IL.Ptr (IL.Sharp ty, lval1, pos) =>
	  let val {value} = ckLval lval1
	      val freshId = Id.new ()
	      val fff = {id = freshId, ty = ty}
	      val _ = VarPool.add fff
	      val assn = M.Assign {line = Counter.next (), dest = O.Var fff, ty = ty, src = value}
	      val _ = StmPool.emit assn
	  in  {value = O.Mem {id = freshId, ty = ty}}
	  end
	| IL.Inarray {lval = blval, exp, length, ty, pos} =>
	  let val _ = debugPrint "array 's type"
	  		val _ = debugPrint (T.toString ty)
	  		val {value = v1} = ckLval blval
	      val {value = v2} = ckExp exp
	      val freshId1 = Id.new ()
	      val freshId2 = Id.new ()
	      val _ = VarPool.add {id = freshId1, ty = T.Intt}
	      val _ = VarPool.add {id = freshId2, ty = ty}
	      val target1 = O.Var {id = freshId1, ty = T.Intt}
	      val target2 = O.Var {id = freshId2, ty = ty}
	      val assn1 = M.Assign {line = Counter.next (), dest = target1, src = v1, ty = ty}
	      val assn2 = M.Assign {line = Counter.next (), dest = target2, src = v2, ty = T.Intt}
	      val _ = StmPool.emit assn1
	      val _ = StmPool.emit assn2
	      val freshId3 = Id.new ()
	      val _ = VarPool.add {id = freshId3, ty = ty}
	      val target3 = O.Var {id = freshId3, ty = ty}
	      val assn3 = M.AssignExp {line = Counter.next (), dest = target3, bop = B.Plus,
	                               src = [target1, target2], ty = ty}
	      val _ = StmPool.emit assn3
	  in  {value = O.Mem {id = freshId3, ty = ty}}
	  end
	| IL.Instruct {lval = slval, id = fname, offSet, pos} =>
	  let val {value} = ckLval slval
	      val idOffSet = Id.new ()
	      val tyOffSet = {id = idOffSet, ty = T.Intt}
	      val varOffSet = O.Var tyOffSet
	      val _ = VarPool.add tyOffSet
	      val newOffSetTimes = M.AssignExp {line = Counter.next (),
	                                        dest = varOffSet,
	                                        bop = B.Times,
	                                        src = [O.IntNum offSet, O.IntNum (Intl.fromInt 4)],
	                                        ty = T.Intt}
	      val _ = StmPool.emit newOffSetTimes
	      val freshId2 = Id.new ()
	      val _ = debugPrint (String.concat ["value of freshId2: ", Id.toString freshId2])
	      val ff2 = {id = freshId2, ty = T.Intt}	      
	      val fff2 = O.Var ff2
	      val _ = VarPool.add ff2
	      val assn =
	          case value
	           of O.Mem {id, ty} =>
	              M.AssignExp {line = Counter.next (),
	                           dest = fff2,
	                           bop = B.Plus,
	                           src = [O.Var {id = id, ty = ty}, varOffSet],
	                           ty = T.Intt}
	            | _ =>
	              M.AssignExp {line = Counter.next (),
	                           dest = fff2,
	                           bop = B.Plus,
	                           src = [value, varOffSet],
	                           ty = T.Intt}
	      val _ = StmPool.emit assn
	  in  {value = O.Mem {id = freshId2, ty = T.Intt}}
	  end
	| _ => raise Fail "to do"
  
  and ckExp (exp) : {value : O.t} =
      case exp
       of IL.Expvoid =>
          {value = O.OpVoid}
	| IL.IntNum i =>
	  {value = O.IntNum i}
	| IL.True =>
	  {value = O.True}
	| IL.False =>
	  {value = O.False}
	| IL.Null =>
	  {value = O.Null}
	| IL.BinopExp {left, bop, right, ty, pos} =>
	  let val {value = v1} = ckExp left
	      val {value = v2} = ckExp right
	      val freshVar = Id.new ()
	      val fff = {id = freshVar, ty = ty}
	      val _ = VarPool.add fff
	      val assn = M.AssignExp {line = Counter.next (), 
	                              dest = O.Var fff,
	                              bop = transBop bop,
	                              src = [v1, v2],
	                              ty = ty}
	      val _ = StmPool.emit assn

	  in  {value = O.Var fff}
	  end
	| IL.NotExp (e, pos) =>
	  let val {value = v} = ckExp e
	      val freshVar = Id.new ()
	      val fff = {id = freshVar, ty = T.Boolt}
	      val _ = VarPool.add fff
	      val assn = M.AssignExp {line = Counter.next (),
	                              dest = O.Var fff,
	                              bop = B.Not,
	                              src = [v],
	                              ty = T.Boolt}
	  in  {value = O.Var fff}
	  end
	| IL.Lval {lval = lval1, ty} =>
	  let val {value} = ckLval (lval1)
	  in  {value = value}
	  end
	| IL.Imply (e1, e2, pos) => raise Fail "to do"
	| IL.Iff (e1, e2, pos) => raise Fail "to do"
	| IL.Forall (tid, atype, e1, pos) => raise Fail "to do"
	| IL.Exists (tid, atype, e1, pos) => raise Fail "to do"
	| IL.Pi (lvalss, pos) => raise Fail "to do"
	| IL.N (lvals, pos) => raise Fail "to do"
	| IL.D (lvals, pos) => raise Fail "to do"
	| IL.Prev (lval, pos) => raise Fail "to do"
	| IL.Result => raise Fail "to do"
	| IL.LList (exp, pos) => raise Fail "to do"
	| IL.Tree (exp, pos) => raise Fail "to do"
	| IL.Pred (id, exp, pos) => raise Fail "to do"
	| IL.Let (e1, e2, e3, pos) => raise Fail "to do"
	
  and ckExps es = 
      let fun cook l =
              case l
               of [] => {values = []}
                | x :: xs => 
                  let val {value} = ckExp x
                      val {values} = ckExps xs
                  in   {values = value :: values}
                  end
      in cook es
      end 
      
  fun ckStm (stm, ret, exit) =
      case stm
       of IM.AsnExp {lval, exp, ty, pos} =>
          let val {value = v1} = ckLval lval
              val {value = v2} = ckExp exp
              val assn = M.Assign {line = Counter.next (), dest = v1, src = v2, ty = ty}
          in  StmPool.emits [assn]
          end
	| IM.AsnAlloc {lval, ty, pos} =>
	  let val {value = v1} = ckLval lval
              val assn = M.Alloc {line = Counter.next (), dest = v1, ty = ty}
          in  StmPool.emits ([assn])
          end
	| IM.AsnCall {lval, fid, ty, exps, pos} =>
	  let val {values} = ckExps exps	      
	      val freshVar = Id.new ()
	      val fff = {id = freshVar, ty = ty}
	      val _ = VarPool.add fff	      
	      val _ = StmPool.emit (M.AssignCall {line = Counter.next (), fid = fid, dest = O.Var fff, src = values})
	      val {value} = ckLval lval
	      val _ = StmPool.emit (M.Assign {line = Counter.next (), dest = value, src = O.Var fff, ty = ty})
	  in  ()
	  end
	| IM.If (cond, s1, s2, pos) =>
	  let val (r1, r2) = (IM.endWithReturns s1, IM.endWithReturns s2)
	  in  case (r1, r2)
	       of (true, true) => 
	  let val {value = v1} = ckExp cond
	      val (lt, lf) = (Id.new (), Id.new ())
	      val _ = StmPool.emit (M.SIf {line = Counter.next (), value = v1, truee = lt, falsee = lf})
	      val _ = StmPool.emit (M.Label {id = lt})
	      val _ = ckStms (s1, ret, exit)
	      val _ = StmPool.emit (M.Label {id = lf})
	      val _ = ckStms (s2, ret, exit)
	  in  ()
	  end
	        | (true, false) =>
	  let val {value = v1} = ckExp cond
	      val (lt, lf, le) = (Id.new (), Id.new (), Id.new ())
	      val _ = StmPool.emit (M.SIf {line = Counter.next (), value = v1, truee = lt, falsee = lf})
	      val _ = StmPool.emit (M.Label {id = lt})
	      val _ = ckStms (s1, ret, exit)
	      val _ = StmPool.emit (M.Label {id = lf})
	      val _ = ckStms (s2, ret, exit)
	      val _ = StmPool.emit (M.SJump {line = Counter.next (), label = le})
	      val _ = StmPool.emit (M.Label {id = le})
	  in  ()
	  end
	        | (false, true) =>
	  let val {value = v1} = ckExp cond
	      val (lt, lf, le) = (Id.new (), Id.new (), Id.new ())
	      val _ = StmPool.emit (M.SIf {line = Counter.next (), value = v1, truee = lt, falsee = lf})
	      val _ = StmPool.emit (M.Label {id = lt})
	      val _ = ckStms (s1, ret, exit)
	      val _ = StmPool.emit (M.SJump {line = Counter.next (), label = le})
	      val _ = StmPool.emit (M.Label {id = lf})
	      val _ = ckStms (s2, ret, exit)
	      val _ = StmPool.emit (M.Label {id = le})
	  in  ()
	  end
	        | (false, false) =>
	  let val {value = v1} = ckExp cond
	      val (lt, lf, le) = (Id.new (), Id.new (), Id.new ())
	      val _ = StmPool.emit (M.SIf {line = Counter.next (), value = v1, truee = lt, falsee = lf})
	      val _ = StmPool.emit (M.Label {id = lt})
	      val _ = ckStms (s1, ret, exit)
	      val _ = StmPool.emit (M.SJump {line = Counter.next (), label = le})
	      val _ = StmPool.emit (M.Label {id = lf})
	      val _ = ckStms (s2, ret, exit)
	      val _ = StmPool.emit (M.SJump {line = Counter.next (), label = le})
	      val _ = StmPool.emit (M.Label {id = le})
	  in  ()
	  end
	  end
	| IM.While {condition, invariant, body, pos} =>
	  if IM.endWithReturns body
	  then raise Fail "compiler bug"
	  else
	  let val {value = v1} = ckExp condition
	      val _ = debugPrint "the value of condition:\n"
	      val _ = debugPrint (IL.expToString condition)
	      val _ = debugPrint "the value of v1:\n"
	      val _ = debugPrint (O.toString v1)
	      val (labelLoop, labelEnd) = (Id.new (), Id.new ())
	      val _ = StmPool.emit (M.SIf {line = Counter.next (), value = v1, truee = labelLoop, falsee = labelEnd})
	      val _ = StmPool.emit (M.Label {id = labelLoop})
	      val _ = ckStms (body, ret, exit)
	      val {value = v2} = ckExp condition
	      val _ = StmPool.emit (M.SIf {line = Counter.next (), value = v2, truee = labelLoop, falsee = labelEnd})
	      val _ = StmPool.emit (M.Label {id = labelEnd})
	  in  ()
	  end
	| IM.Return {exp, fty, pos} =>
	  let val {value = v} = ckExp exp	      
	      val assn = M.Assign {line = Counter.next (), dest = ret, src = v, ty = T.Intt}
	      val _ = StmPool.emit assn
	      val _ = StmPool.emit (M.SJump {line = Counter.next (), label = exit})
	  in  ()
	  end
	| IM.Call (fname, paras, pos) =>
	  let val {values} = ckExps paras
	      val call = M.Call {line = Counter.next (), fid = fname, src = values}
	      val _ = StmPool.emit call
	  in  ()
	  end
	| IM.Free (e, pos) =>
	  let val {value} = ckExp e
	      val free = M.Call {line = Counter.next (), fid = Id.fromString "free", src = [value]}
	  in  ()
	  end
	| IM.Prop (exp, p) => raise Fail "to do" 
	
  and ckStms (stms, ret, exit) =
      List.app (fn x => ckStm (x, ret, exit)) stms
  
  fun stmize () =
      let fun delete l =
              case l
               of [] => []
                | [x] => [x]
                | [x as M.SJump _, y as M.SJump _] => [x]
                | [_, _] => l
                | (x as M.SJump _) :: (y as M.SJump _) :: xs =>
                  x :: (delete xs)
                | x :: xs =>
                  x :: (delete xs)
          fun cook l =
              case l
               of [] => ()
                | (x as M.SJump {label, ...}) :: xs =>
                  (BlockPool.add x;
                  BlockPool.flush ([label]);
                  cook xs)
                | (x as M.SIf {truee, falsee, ...}) :: xs =>
                  (BlockPool.add x;
                  BlockPool.flush ([truee, falsee]);
                  cook xs)
                | x :: xs => 
                  (BlockPool.add x;
                  cook xs)
          val all = StmPool.get ()
          val all = delete all
      in  cook all
      end
  
  fun blockize (name, ret, exit, stm) =
      let val _ = StmPool.init ()
          val _ = StmPool.emit (M.Label {id = name})
          val _ = ckStms (stm, ret, exit)
          val _ = stmize ()
      in  BlockPool.getAll ()
      end
      
     
  fun adjust b =
      case b
       of K.T {name,
                prop,
                stms,
                transfer,
                successors} =>
      	  let fun getName stms =
      	          case stms
      	           of [] => raise Fail "compiler : empty stms"
      	            | M.Label {id} :: xs => (id, xs)
      	            | _ :: xs => (print "compiler bug: no label name"; (Id.new (), xs))
      	      val (realName, others) = getName stms
      	      fun getTransfer stms =
      	          case List.rev stms
      	           of [] => raise Fail "compiler bug: empty stms"
      	            | (x as M.SJump v) :: xs => (J.Jump v, List.rev xs)
      	            | (x as M.SIf v) :: xs => (J.If v, List.rev xs)
      	            | _ => raise Fail "compiler : no label name"
      	      val (transfer, others) = getTransfer others
      	  in  K.T {name = realName,
                prop = prop,
                stms = others,
                transfer = transfer,
                successors = successors}
      	  end
      	        
  fun adjusts bs = List.map adjust bs      
  
  val {get = defSites, set = setDefSites, destroy = destroyDefSites, ...} :
      {get : Id.t -> Id.t list, set : Id.t * Id.t list -> unit, destroy : unit -> unit} =
      Property.destGetSet (Id.plist, Property.initConst [])
  
  val {get = phi, set = setPhi, destroy = destroyPhi, ...} :
      {get : unit DiGraph.Node.t -> Id.t list, set : unit DiGraph.Node.t * Id.t list -> unit,
      destroy : unit -> unit} =
      Property.destGetSet (DiGraph.Node.plist, Property.initConst [])
  
  (*
  val {get = count, set = setCount, destroy = destroyCount, ...} :
      {get : Id.t -> Id.t option, set : Id.t * Id.t option -> unit,
       destroy : unit -> unit}=
      Property.destGetSet (Id.plist, Property.initConst NONE)
      *)
      
  val {get = subst, set = setSubst, destroy = destroySubst, ...} :
      {get : Id.t -> Id.t option, set : Id.t * Id.t option -> unit,
       destroy : unit -> unit}=
      Property.destGetSet (Id.plist, Property.initConst NONE)
      
  val {get = stack, set = setStack, destroy = destroyStack, ...} :
      {get : Id.t -> Id.t list, set : Id.t * Id.t list -> unit,
       destroy : unit -> unit}=
      Property.destGetSet (Id.plist, Property.initConst [])
  
  val {get = orig, set = setOrig, destroy = destroyOrig, ...} :
      {get : Id.t -> Id.t option, set : Id.t * Id.t option -> unit,
       destroy : unit -> unit}=
      Property.destGetSetOnce (Id.plist, Property.initConst NONE)
      
  fun initCountAndStack vars =
      case vars
       of [] => ()
        | x :: xs =>
          let val _ = setStack (x, [x])
          in  initCountAndStack xs
          end
          
  fun checkCountAndStack vars =
      case vars
       of [] => ()
        | x :: xs =>
          let val stack = stack x
              val _ = printList (x, stack, "stack")
          in  checkCountAndStack xs
          end
          
  exception EmptyStack of string
  
  fun topStack x =
      let val stack = stack x
      in  case stack
           of [] => (debugPrint (Id.toString x); raise EmptyStack "compiler bug")
            | y :: _ => y
      end
      
  fun popStack x =
      let val stack = stack x
      in  case stack
           of [] => raise EmptyStack "compiler bug"
            | y :: ys => setStack (x, ys)
      end
       
  fun defSitesBlocks (x, blocks) =
      case blocks
       of [] => ()
        | y :: ys =>
          let val origs = K.orig y
              val name = K.name y
              val oldDefSites = defSites x
              val _ = if List.exists (fn y => Id.equals (x, y)) origs
                        then if List.exists (fn y => Id.equals (name, y)) oldDefSites
                             then ()
                             else setDefSites (x, name :: oldDefSites)
                        else ()
          in  defSitesBlocks (x, ys)
          end
      
  fun calculateDefSites (vars, blocks) =
      case vars
       of [] => ()
        | x :: xs =>
          let val _ = defSitesBlocks (x, blocks)
          in  calculateDefSites (xs, blocks)
          end
          
  fun checkDefSites vars =
      case vars
       of [] => debugPrint "\n"
        | x :: xs =>
          let val _ = printList (x, defSites x, "defsites")
          in  checkDefSites xs
          end
  
  fun cookVariables (vars, graph, getBlock, setBlock, getDf, labelNode, getName) =
      let fun loopVars l =
              case l
               of [] => ()
                | x :: xs =>
                  let val defSitesRef : Id.t list ref = ref (defSites x)
                      fun decompose () =
                          case !defSitesRef
                           of x :: xs => (defSitesRef := xs; x)
                            | _ => raise Fail "compiler bug"
                      fun loopDefSites () =
                          case (!defSitesRef)
                           of [] => ()
                            | _ =>
                              let val n = decompose ()
                                  val node = labelNode n
                                  val df : unit DiGraph.Node.t list = getDf node
                                  fun loopDf l =
                                      case l
                                       of [] => ()
                                        | y :: ys =>
                                          let val phiY = phi y
                                          in  if List.exists (fn m => Id.equals (x, m)) phiY
                                              then ()
                                              else let fun mkList (elm, preds) =
                                                           case preds 
                                                            of [] => []
                                                             | p :: ps => {operand = elm, from = p}
                                                                         :: (mkList (elm, ps))
                                                       val obj = O.Var {id = x, ty = T.Intt}
                                                       val newStm =
                                                           M.Phi {line = Counter.next (),
                                                                  dest = obj,
                                                                  src = mkList (obj,
                                                                                List.map getName
                                                                                (DiGraph.predecessors (graph, y)))}
                                                       val oldBlock = valOf (getBlock y)
                                                       val newBlock = K.addStm (oldBlock, newStm)
                                                       val _ = setBlock (y, SOME newBlock)
                                                       val _ = setPhi (y, x :: phiY)
                                                       val _ = if List.exists (fn mm => Id.equals (x, mm)) 
                                                                              (K.orig (valOf (getBlock y)))
                                                               then ()
                                                               else defSitesRef := (getName y) :: (!defSitesRef)
                                                   in  loopDf ys
                                                   end
                                          end
                                  val _ = loopDf df                    
                              in  loopDefSites ()
                              end
                      val _ = loopDefSites ()
                  in  loopVars xs
                  end
      in  loopVars vars
      end
    
  fun rename (start, graph, getBlock, setBlock, getDf, labelNode, getName, dominatorTree, child) =
      let val n = labelNode start
          val K.T {name, prop, stms, transfer, successors, ...} = valOf (getBlock n)
          fun cookStmSrc s = 
              if M.isPhi s
              then s
              else M.substUses (s, topStack)
          fun cookTransfer l = J.substUses (l, topStack)
          fun cookStmDest s =
              let val dest = M.cookDest s
                  val new = case dest
                           of NONE => s
                            | SOME dest =>
                              let val _ =
                                      if M.isAssignMem s
                                      then ()
                                      else let val fresh = Id.new ()
                                  val _ = setOrig (fresh, SOME dest)
                                  val _ = VarPool.add {id = fresh, ty = T.Intt}
                                  val oldStack = stack dest
                                  val _ = setStack (dest, fresh :: oldStack)
                                  fun fff x = case orig x
                                               of NONE => x
                                                | SOME v => topStack v
                                                  handle (EmptyStack _) => raise Fail (Id.toString v)
                                      in  ()
                                      end
                              in  M.substDest (s, topStack)
                              end
              in  new
              end
          fun loopStms s =
              case s
               of [] => []
                | x :: xs => 
                  let val newx = cookStmSrc x
                      val newxx = cookStmDest newx
                  in  newxx :: (loopStms xs)
                  end
          val newStms = loopStms stms
          val newTransfer = cookTransfer transfer
          val newBlock = K.T {name = name,
                              prop = prop,
                              stms = newStms,
                              transfer = newTransfer,
                              successors = successors}
          val _ = setBlock (n, SOME newBlock)
          val succsOfN = DiGraph.Node.successors n
          fun loopSuccs l =
              case l
               of [] => ()
                | y :: ys =>
                  let val K.T {name, prop, stms, transfer, successors, ...} = valOf (getBlock y)
                      fun substPhi (ss, f, start) = List.map (fn mm => M.substPhi (mm, f, start)) ss
                      val _ = debugPrint (String.concat ["\nnow substituting Phi in:", Id.toString name, "\n"])
                      fun fff x =
                          case orig x
                           of NONE => ((topStack x)
                                      handle (EmptyStack _) => raise Fail (Id.toString x))
                            | SOME v =>
                              let val _ = debugPrint (String.concat ["the variable is: ", Id.toString v])
                              in  topStack v
                                  handle (EmptyStack _) => raise Fail (Id.toString v)
                              end
                      val newStms = substPhi (stms, fff, start)
                      val newBlock = K.T {name = name,
                                          prop = prop,
                                          stms = newStms,
                                          transfer = transfer,
                                          successors = successors}
                      val _ = setBlock (y, SOME newBlock)
                  in  loopSuccs ys
                  end
          
          val _ = loopSuccs succsOfN
          val childs = child start
          val _ = printList (start, childs, "children")
          val _ = List.app (fn y => rename (y, graph, getBlock, 
                              setBlock, getDf, labelNode, getName, dominatorTree, child))
                            childs
          val K.T {name, prop, stms, transfer, successors, ...} = valOf (getBlock n)
          fun loopPop l =
              case l
               of [] => ()
                | x :: xs =>
                  let val id = M.cookDest x
                      val _ = case id
                               of NONE => ()
                                | SOME id =>
                                  let val _ = debugPrint (String.concat ["\nnow poping: ",
                                                           Id.toString id, "\n"])
                                      val orig = orig id
                                  in  case orig
                                       of NONE => raise Fail "compiler bug"
                                        | SOME g => popStack g
                                  end
                  in loopPop xs
                  end
          val _ = loopPop stms
      in   () 
      end
      
  fun transFunc f =
      case f
       of IF.T {name,
               rettype,
               args,
               locals,
               stm,
               pre,
               post,
               pos} =>
      let val ret = Id.new ()
          val ret = {id = ret, ty = T.Intt}
	  val dest = O.Var ret
	  val _ = VarPool.add ret
          val exit = Id.new ()
          val allStms = blockize (name, dest, exit, stm)
          val newBlocks =
              if doAdjust
              then adjusts allStms
              else allStms
          val tail = K.T {name = exit,
                          prop = true,
                          stms = [],
                          transfer = J.Return {line = Counter.next (), value = dest},
                          successors = []}
          val newBlocks = newBlocks @ [tail]
          val _ = debugPrint "before output aaa.c"          
          val _ = if tag
                  then File.output ("aaa.c", String.concat (List.map K.toString newBlocks))
                  else ()                  
          val _ = debugPrint "after output aaa.c"
          val newLocals = locals @ (VarPool.getAll ())
          val newPre = O.True
          val newPost = O.True
          val new = F.T {name = name,
                         exit = exit,
                         rettype = rettype,
                         args = args,
                         locals = newLocals,
                         blocks = newBlocks,
                         pre = newPre,
                         post = newPost}
                         
          val _ = if tag
                  then let val _ = F.toDot (new, String.concat [F.stringName new, "Cfg"])
                           val _ = F.toDotTree new
                           val _ = F.toDotDomTree new
                           val _ = F.df new
                       in  ()
                       end
                  else ()
      in  new
      end
      
  fun transProg p =
      case p
       of IP.T {structs,
                gvars,
                funcs,
                pos} =>
          P.T {structs = [],
               gvars = gvars,
               funcs = List.map transFunc funcs}
      
  fun transFuncSsa f =
      case f
       of F.T {name,
               exit,
               rettype,
               args,
               locals,
               blocks,
               pre,
               post} =>
          let val allVars = List.map #id (args @ locals)
              val _ = calculateDefSites (allVars, blocks)
              val _ = checkDefSites allVars
              val {graph, getBlock, setBlock, getDf, labelNode, getName, ...} = F.ssaUtil f
              val _ = cookVariables (allVars, graph, getBlock, setBlock, getDf, labelNode, getName)
              val _ = destroyDefSites ()
              val new1 = F.T {name = name,
                              exit = exit,
                              rettype = rettype,
                              args = args,
                              locals = locals,
                              blocks = F.fromGraph graph,
                              pre = pre,
                              post = post}
              val _ = if tag
                      then F.toDot (new1, String.concat [F.stringName new1, "VarSsa"])
                      else ()
              val {graph, getBlock, setBlock, getDf, labelNode, getName, ...} = F.ssaUtil new1
              val {tree = dominatorTree, labelTreeNode = child} = F.dominatorTree new1
              val _ = initCountAndStack (List.map #id (args @ locals))
                             val _ = debugPrint "\nthe initial count and stack are:\n"
                             val _ = checkCountAndStack (List.map #id (args @ locals))
                             val _ = debugPrint "\noutput the initial count and stack finished\n"
                             val _ = rename (name, graph, getBlock, setBlock, getDf,
                                             labelNode, getName, dominatorTree, child)
                             val _ = debugPrint "\nthe count and stack after rename are:\n"
                             val _ = checkCountAndStack (List.map #id (args @ locals))
                             val _ = debugPrint "\noutput the initial count and stack after rename finished\n"
                             val new2 = F.T {name = name,
                                     exit = exit,
                                     rettype = rettype,
                                     args = args,
                                     locals = locals @ VarPool.getAll (),
                                     blocks = F.fromGraph graph,
                                     pre = pre,
                                     post = post}
                             val _ = debugPrint "after new2\n"

                             val _ = if tag 
                                     then let val _ = F.toDot (new2, String.concat [F.stringName new2, "FinalSsa"])
                                          in  ()
                                          end
                                     else ()
                             val _ = debugPrint "after tag\n"
                                  (*   
                             val _ = destroyOrig ()
                             val _ = destroyStack ()
                                    *) 
           in  new2
           end
  
  fun transProgSsa p =
      case p
       of P.T {structs,
               gvars,
               funcs} =>
          if !Control.doToSsa
          then let val new = P.T {structs = [],
                                  gvars = gvars,
                                  funcs = List.map transFuncSsa funcs}
                   val _ = if !Control.doKeepSsa
                           then File.output ((!Control.fileName)^".ssa.c", Cfg.Program.toString new)
                           else ()
               in  new
               end
          else p
  
  fun trans p =
      let val _ = debugPrint "cfg translation starting\n"
          val new = transProg p
          val _ = if !Control.doKeepCfg
                  then File.output ((!Control.fileName)^".cfg.c", Cfg.Program.toString new)
                  else ()
          val new = transProgSsa new
          val _ = debugPrint "cfg translation finished\n"
      in  new
      end
end
